home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / graph.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  12.8 KB  |  577 lines  |  [TEXT/R*ch]
  1. /* Stub code for the graphic primitives */
  2. /* This version has been modified for Moscow ML and won't work for 
  3.    Caml Light any more */
  4.  
  5. #include <math.h>
  6. #include <grx.h>
  7. #include <mousex.h>
  8. #include <dos.h>
  9. #include "mlvalues.h"
  10. #include "alloc.h"
  11. #include "memory.h"
  12. #include "fail.h"
  13.  
  14. #define Unit Atom(0)
  15.  
  16. int size_x, size_y, max_x, max_y;
  17. int cx, cy;
  18. int cc;
  19.  
  20. #define Cvt(y) (max_y - (y))
  21.  
  22. static void graphic_failure(msg)
  23.      char * msg;
  24. {
  25.   raise_with_string(GRAPHIC_FAILURE_EXN, msg);
  26. }
  27.  
  28. value gr_open_graph(mode)       /* ML */
  29.      value mode;
  30. {
  31.   char * mode_name;
  32.   int mode_code, width, height;
  33.   
  34.   mode_name = String_val(mode);
  35.   mode_code = GR_default_graphics;
  36.   width = 0;
  37.   height = 0;
  38.   if (strcmp(mode_name, "biggest") == 0) {
  39.     mode_code = GR_biggest_graphics;
  40.   } else if (strcmp(mode_name, "noninterlaced") == 0) {
  41.     mode_code = GR_biggest_noninterlaced_graphics;
  42.   } else if (strcmp(mode_name, "320x200") == 0) {
  43.     mode_code = GR_320_200_graphics;
  44.   } else if (sscanf(mode_name, "%dx%d", &width, &height) == 2) {
  45.     mode_code = GR_width_height_graphics;
  46.   }
  47.   GrSetMode(mode_code, width, height);
  48.   size_x = GrSizeX();
  49.   size_y = GrSizeY();
  50.   max_x = GrMaxX();
  51.   max_y = GrMaxY();
  52.   cx = 0;
  53.   cy = Cvt(0);
  54.   cc = GrWhite();
  55.   return Unit;
  56. }
  57.  
  58. value gr_close_graph()  /* ML */
  59. {
  60.   GrSetMode(GR_default_text, 0, 0);
  61.   return Unit;
  62. }
  63.  
  64. value gr_clear_graph()  /* ML */
  65. {
  66.   GrClearScreen(GrBlack());
  67.   GrResetColors();
  68.   return Unit;
  69. }
  70.  
  71. value gr_size_x()       /* ML */
  72. {
  73.   return Val_long(size_x);
  74. }
  75.  
  76. value gr_size_y()       /* ML */
  77. {
  78.   return Val_long(size_y);
  79. }
  80.  
  81. static int rgb_to_color(r, g, b)
  82.      int r, g, b;
  83. {
  84.   int best_c, c, best_dist, dist, dr, dg, db;
  85.  
  86.   c = GrAllocColor(r, g, b);
  87.   if (c != GrNOCOLOR) return c;
  88.   best_c = 0;
  89.   best_dist = 0x100000;
  90.   for (c = GrNumColors() - 1; c >= 0; c--) {
  91.     GrQueryColor(c, &dr, &dg, &db);
  92.     dr -= r; dg -= g; db -= b;
  93.     dist = dr*dr + dg*dg + db*db;
  94.     if (dist == 0) return c;
  95.     if (dist < best_dist) { best_c = c; best_dist = dist; }
  96.   }
  97.   return best_c;
  98. }
  99.  
  100. static void color_to_rgb(c, r, g, b)
  101.      int c, * r, * g, * b;
  102. {
  103.   GrQueryColor(c, r, g, b);
  104. }
  105.  
  106. value gr_set_color(color)       /* ML */
  107.      value color;
  108. {
  109.   int rgb, r, g, b;
  110.  
  111.   rgb = Long_val(color);
  112.   r = (rgb >> 16) & 0xFF;
  113.   g = (rgb >> 8) & 0xFF;
  114.   b = rgb & 0xFF;
  115.   cc = rgb_to_color(r, g, b);
  116.   return Unit;
  117. }
  118.  
  119. value gr_plot(x, y)     /* ML */
  120.      value x, y;
  121. {
  122.   GrPlot(Int_val(x), Cvt(Int_val(y)), cc);
  123.   return Unit;
  124. }
  125.  
  126. value gr_point_color(x, y)      /* ML */
  127.      value x, y;
  128. {
  129.   int c, r, g, b;
  130.  
  131.   c = GrPixel(Int_val(x), Cvt(Int_val(y)));
  132.   color_to_rgb(c, &r, &g, &b);
  133.   return Val_long((r << 16) + (g << 8) + b);
  134. }
  135.  
  136. value gr_moveto(x, y)   /* ML */
  137.      value x, y;
  138. {
  139.   cx = Int_val(x);
  140.   cy = Cvt(Int_val(y));
  141.   return Unit;
  142. }
  143.  
  144. value gr_current_point()        /* ML */
  145. {
  146.   value res;
  147.   res = alloc_tuple(2);
  148.   Field(res, 0) = Val_int(cx);
  149.   Field(res, 1) = Val_int(Cvt(cy));
  150.   return res;
  151. }
  152.  
  153. value gr_lineto(x, y)   /* ML */
  154.      value x, y;
  155. {
  156.   int xp, yp;
  157.   xp = Int_val(x);
  158.   yp = Cvt(Int_val(y));
  159.   GrLine(cx, cy, xp, yp, cc);
  160.   cx = xp;
  161.   cy = yp;
  162.   return Unit;
  163. }
  164.  
  165. value gr_draw_arc(argv, argc)   /* ML */
  166.      value * argv;
  167.      int argc;
  168. {
  169.   int a1, a2;
  170.   a1 = 360 - Int_val(argv[5]);
  171.   a2 = 360 - Int_val(argv[4]);
  172.   GrEllipseArc(Int_val(argv[0]), Cvt(Int_val(argv[1])),
  173.            Int_val(argv[2]), Int_val(argv[3]), a1 * 10, a2 * 10, cc);
  174.   return Unit;
  175. }
  176.  
  177. static GrTextOption * text_option()
  178.  
  179. {
  180.   static GrTextOption textopt = {
  181.     NULL,                       /* font */
  182.     1, 1,                       /* X, Y magnification */
  183.     GrNOCOLOR, GrNOCOLOR,       /* foreground, background */
  184.     GR_TEXT_RIGHT,              /* direction */
  185.     GR_ALIGN_LEFT,              /* X alignment */
  186.     GR_ALIGN_BOTTOM,            /* Y alignment */
  187.     GR_BYTE_TEXT
  188.   };
  189.   if (textopt.txo_font == NULL) {
  190.     if ((textopt.txo_font = GrLoadBIOSFont("@:pc8x16.fnt")) == NULL &&
  191.     (textopt.txo_font = GrLoadBIOSFont("@:pc8x14.fnt")) == NULL &&
  192.     (textopt.txo_font = GrLoadBIOSFont("@:pc8x8.fnt")) == NULL)
  193.       graphic_failure("cannot find default font");
  194.   }
  195.   textopt.txo_fgcolor.v = cc;
  196.   return &textopt;
  197. }
  198.  
  199. value gr_draw_char(c)   /* ML */
  200.      value c;
  201. {
  202.   GrTextOption * topt = text_option();
  203.   GrDrawChar(Int_val(c), cx, cy, topt);
  204.   cx += GrCharWidth(Int_val(c), topt);
  205.   return Unit;
  206. }
  207.  
  208. value gr_draw_string(s) /* ML */
  209.      value s;
  210. {
  211.   GrTextOption * topt = text_option();
  212.   GrDrawString(String_val(s), string_length(s), cx, cy, topt);
  213.   cx += GrStringWidth(String_val(s), string_length(s), topt);
  214.   return Unit;
  215. }
  216.  
  217. value gr_text_size(s)   /* ML */
  218.      value s;
  219. {
  220.   GrTextOption * topt = text_option();
  221.   int sx, sy;
  222.   value res;
  223.   
  224.   sx = GrStringWidth(String_val(s), string_length(s), topt);
  225.   sy = GrStringHeight(String_val(s), string_length(s), topt);
  226.   res = alloc_tuple(2);
  227.   Field(res, 0) = Val_int(sx);
  228.   Field(res, 1) = Val_int(sy);
  229.   return res;
  230. }
  231.  
  232. value gr_fill_rect(vx, vy, vw, vh)      /* ML */
  233.      value vx, vy, vw, vh;
  234. {
  235.   int x, y, w, h;
  236.   x = Int_val(vx);
  237.   y = Int_val(vy);
  238.   w = Int_val(vw);
  239.   h = Int_val(vh);
  240.   y = Cvt(y + h - 1);
  241.   GrFilledBox(x, y, x+w-1, y+h-1, cc);
  242.   return Unit;
  243. }
  244.  
  245. value gr_fill_arc(argv, argc)   /* ML */
  246.      value * argv;
  247.      int argc;
  248. {
  249.   int a1, a2;
  250.   a1 = - Int_val(argv[5]);
  251.   while (a1 < 0) a1 += 360;
  252.   while (a1 >= 360) a1 -= 360;
  253.   a2 = - Int_val(argv[4]);
  254.   while (a2 <= 0) a2 += 360;
  255.   while (a2 > 360) a2 -= 360;
  256.   GrFilledEllipseArc(Int_val(argv[0]), Cvt(Int_val(argv[1])),
  257.              Int_val(argv[2]), Int_val(argv[3]), a1 * 10, a2 * 10, cc);
  258.   return Unit;
  259. }
  260.  
  261. value gr_fill_poly(v)   /* ML */
  262.      value v;
  263. {
  264.   int numpoints = Wosize_val(v);
  265.   int points[numpoints][2];
  266.   int i;
  267.  
  268.   for (i = 0; i < numpoints; i++) {
  269.     points[i][0] = Int_val(Field(Field(v, i), 0));
  270.     points[i][1] = Cvt(Int_val(Field(Field(v, i), 1)));
  271.   }
  272.   GrFilledPolygon(numpoints, points, cc);
  273.   return Unit;
  274. }
  275.  
  276. static value new_bitmap(width, height)
  277.      int width, height;
  278. {
  279.   unsigned bsize;
  280.   mlsize_t wsize;
  281.  
  282.   bsize = GrContextSize(width, height);
  283.   wsize = (bsize + 3) >> 2;
  284.   if (wsize == 0)       /* never allocate an empty object */
  285.     return Atom(Abstract_tag);
  286.   if (wsize <= Max_young_wosize)
  287.     return alloc(wsize, Abstract_tag);
  288.   else
  289.     return alloc_shr(wsize, Abstract_tag);
  290. }
  291.  
  292. struct image {
  293.   value width;                  /* Width, in pixels */
  294.   value height;                 /* Height, in pixels */
  295.   value data;                   /* Image data */
  296.   value mask;                   /* Image mask (or Val_long(0) if empty) */
  297. };
  298.  
  299. value gr_draw_image(image, vx, vy)      /* ML */
  300.      struct image * image;
  301.      value vx, vy;
  302. {
  303.   GrContext source;
  304.   int h, w, x, y;
  305.   w = Int_val(image->width);
  306.   h = Int_val(image->height);
  307.   x = Int_val(vx);
  308.   y = Cvt(Int_val(vy) + h - 1);
  309.   if (Is_long(image->mask)) {
  310.     GrCreateContext(w, h, (char *) image->data, &source);
  311.     GrBitBlt(NULL, x, y, &source, 0, 0, w, h, GrWRITE);
  312.   } else {
  313.     GrCreateContext(w, h, (char *) image->mask, &source);
  314.     GrBitBlt(NULL, x, y, &source, 0, 0, w, h, GrAND);
  315.     GrCreateContext(w, h, (char *) image->data, &source);
  316.     GrBitBlt(NULL, x, y, &source, 0, 0, w, h, GrOR);
  317.   }
  318.   return Unit;
  319. }
  320.  
  321. value gr_create_image(vw, vh)           /* ML */
  322.     value vw, vh;
  323. {
  324.   int w, h;
  325.   struct image * res;
  326.   Push_roots(roots, 1)
  327. #define bitmap roots[0]
  328.   w = Int_val(vw);
  329.   h = Int_val(vh);
  330.   bitmap = new_bitmap(w, h);
  331.   res = (struct image *) alloc_tuple(4);
  332.   res->width = Val_int(w);
  333.   res->height = Val_int(h);
  334.   res->data = bitmap;
  335.   res->mask = Val_int(0);
  336.   Pop_roots();
  337.   return (value) res;
  338. #undef bitmap
  339. }
  340.  
  341. value gr_blit_image(image, vx, vy)      /* ML */
  342.     struct image * image;
  343.     value vx, vy;
  344. {
  345.   GrContext dest;
  346.   int x, y, w, h;
  347.   
  348.   w = Int_val(image->width);
  349.   h = Int_val(image->height);
  350.   x = Int_val(vx);
  351.   y = Cvt(Int_val(vy) + h - 1);
  352.   GrCreateContext(w, h, (char *) image->data, &dest);
  353.   GrBitBlt(&dest, 0, 0, NULL, x, y, x+w, y+h, GrWRITE);
  354.   return Atom(0);
  355. }
  356.  
  357. value gr_make_image(color_matrix)       /* ML */
  358.      value color_matrix;
  359. {
  360.   int width, height;
  361.   int i, j;
  362.   struct image * res;
  363.   value row;
  364.   int rgb;
  365.   GrContext context;
  366.   int has_transp;
  367.   Push_roots(roots, 3)
  368. #define v roots[0]
  369. #define bm_data roots[1]
  370. #define bm_mask roots[2]
  371.  
  372.   v = color_matrix;
  373.   height = Wosize_val(v);
  374.   if (height == 0) {
  375.     width = 0;
  376.   } else {
  377.     width = Wosize_val(Field(v, 0));
  378.     for (i = 1; i < height; i++) {
  379.       if (width != Wosize_val(Field(v, i)))
  380.     graphic_failure("make_image: non-rectangular matrix");
  381.     }
  382.   }
  383.   bm_data = new_bitmap(width, height);
  384.   GrCreateContext(width, height, (char *) bm_data, &context);
  385.   GrSetContext(&context);
  386.   has_transp = 0;
  387.   for (j = 0; j < height; j++) {
  388.     row = Field(v, j);
  389.     for(i = 0; i < width; i++) {
  390.       rgb = Long_val(Field(row, i));
  391.       if (rgb == -1) {
  392.     has_transp = 1;
  393.     GrPlot(i, j, 0);
  394.       } else {
  395.     GrPlot(i, j, 
  396.            rgb_to_color((rgb>>16) & 0xFF, (rgb>>8) & 0xFF, rgb & 0xFF));
  397.       }
  398.     }
  399.   }
  400.   if (has_transp) {
  401.     bm_mask = new_bitmap(width, height);
  402.     GrCreateContext(width, height, (char *) bm_mask, &context);
  403.     GrSetContext(&context);
  404.     GrClearContext(0);
  405.     for (j = 0; j < height; j++) {
  406.       row = Field(v, j);
  407.       for(i = 0; i < width; i++) {
  408.     if (Long_val(Field(row, i)) == -1) GrPlot(i, j, 255);
  409.       }
  410.     }
  411.   } else {
  412.     bm_mask = Val_int(0);
  413.   }
  414.   GrSetContext(NULL);
  415.   res = (struct image *) alloc_tuple(4);
  416.   res->width = Val_int(width);
  417.   res->height = Val_int(height);
  418.   res->data = bm_data;
  419.   res->mask = bm_mask;
  420.   Pop_roots();
  421.   return (value) res;
  422. #undef v
  423. #undef bm_data
  424. #undef bm_mask
  425. }
  426.  
  427. /* For Moscow ML we make it return an array of arrays instead: */
  428.  
  429. static value alloc_int_vect(size)
  430.      mlsize_t size;
  431. {
  432.   value res;
  433.   mlsize_t i;
  434.   
  435.   if (size <= Max_young_wosize) {
  436.     res = alloc(size, Reference_tag);
  437.   } else {
  438.     res = alloc_shr(size, Reference_tag);
  439.   }
  440.   for (i = 0; i < size; i++) {
  441.     Field(res, i) = Val_long(0);
  442.   }
  443.   return res;
  444. }
  445.  
  446. value gr_dump_image(image)      /* ML */
  447.      struct image * image;
  448. {
  449.   int height, width, i, j;
  450.   unsigned char * p;
  451.   int r, g, b;
  452.   GrContext context;
  453.   int c;
  454.   Push_roots(roots, 2);
  455. #define img ((struct image *) roots[0])
  456. #define matrix (roots[1])
  457.  
  458.   img = image;
  459.   height = Int_val(img->height);
  460.   width  = Int_val(img->width);
  461.   matrix = alloc_int_vect(height);
  462.   for (i = 0; i < height; i++) {
  463.     value row = alloc_int_vect(width);
  464.     modify(&Field(matrix, i), row);
  465.   }
  466.   GrCreateContext(width, height, (char *) img->data, &context);
  467.   GrSetContext(&context);
  468.   for (i = 0; i < height; i++) {
  469.     for (j = 0; j < width; j++) {
  470.       c = GrPixel(j, i);
  471.       color_to_rgb(c, &r, &g, &b);
  472.       Field(Field(matrix, i), j) = Val_long((r << 16) + (g << 8) + b);
  473.     }
  474.   }
  475.   if (img->mask != Val_long(0)) {
  476.     GrCreateContext(width, height, (char *) img->mask, &context);
  477.     GrSetContext(&context);
  478.     for (i = 0; i < height; i++) {
  479.       for (j = 0; j < width; j++) {
  480.     c = GrPixel(j, i);
  481.     if (c == 255) Field(Field(matrix, i), j) = Val_long(-1);
  482.       }
  483.     }
  484.   }
  485.   Pop_roots();
  486.   return matrix;
  487. #undef img
  488. #undef matrix
  489. }
  490.  
  491. static int event_codes[] = {
  492.   M_BUTTON_DOWN, M_BUTTON_UP, M_KEYPRESS, M_MOTION, M_POLL
  493. };
  494.  
  495. /* Moscow ML expects gr_wait_events to return fields in this order: 
  496.     0 - button
  497.     1 - key
  498.     2 - keypressed
  499.     3 - mouse_x
  500.     4 - mouse_y
  501.   Caml Light expects 3, 4, 0, 2, 1
  502. */
  503.  
  504. value gr_wait_event(events)     /* ML */
  505.      value events;
  506. {
  507.   int event_mask;
  508.   value res;
  509.   MouseEvent e, e2;
  510.  
  511.   enter_blocking_section();
  512.   for (event_mask = 0; Tag_val(events) == 1; events = Field(events, 1))
  513.     event_mask |= event_codes[Tag_val(Field(events, 0))];
  514.   if (event_mask & M_POLL) {
  515.     MouseGetEvent(M_MOTION|M_BUTTON_DOWN|M_BUTTON_UP|M_POLL|M_NOPAINT, &e);
  516.     e.key = kbhit() ? 0 : -1;
  517.   } else {
  518.     e.key = -1;
  519.     MouseGetEvent(event_mask, &e);
  520.     MouseGetEvent(M_MOTION|M_BUTTON_DOWN|M_BUTTON_UP|M_POLL|M_NOPAINT, &e2);
  521.     if ((e.flags & (M_MOTION | M_BUTTON_DOWN | M_BUTTON_UP)) == 0) {
  522.       e.x = e2.x; e.y = e2.y; e.buttons = e2.buttons;
  523.     }
  524.   }
  525.   leave_blocking_section();
  526.   res = alloc_tuple(5);
  527.   Field(res, 3) = Val_int(e.x);
  528.   Field(res, 4) = Val_int(Cvt(e.y));
  529.   Field(res, 0) = Atom(e.buttons != 0);
  530.   if (e.key == -1) {
  531.     Field(res, 2) = Atom(0);
  532.     Field(res, 1) = Val_int(0);
  533.   } else {
  534.     Field(res, 2) = Atom(1);
  535.     Field(res, 1) = Val_int(e.key);
  536.   }
  537.   return res;
  538. }
  539.  
  540. static unsigned get_time()
  541. {
  542.   union REGS r;
  543.   
  544.   r.x.ax = 0;
  545.   int86(0x1A, &r, &r);
  546.   return (r.x.cx << 16) + r.x.dx;
  547. }
  548.  
  549. value gr_sound(freq, duration)  /* ML */
  550.     value freq, duration;
  551. {
  552.   int start, d, t;
  553.     
  554.   enter_blocking_section();
  555.   sound(Long_val(freq));
  556.   start = get_time();
  557.   d = Long_val(duration) / 55;
  558.   do {
  559.     t = get_time() - start;
  560.     if (t < 0) t += 1572997;
  561.   } while (t < d);
  562.   sound(0);
  563.   leave_blocking_section();
  564.   return Atom(0);
  565. }
  566.  
  567. /* New function for Moscow ML */
  568.  
  569. value gr_image_size(image)      /* ML */
  570.      struct image * image;
  571. { value res;
  572.   res = alloc_tuple(2);
  573.   Field(res, 0) = image -> width;
  574.   Field(res, 1) = image -> height;
  575.   return res;
  576. }
  577.